home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 1
/
Precision Software Applications Silver Collection Volume One (PSM) (1993).iso
/
tutor
/
dbase1iv.exe
/
DB4LESS3.ZIP
/
CUSTMENU.PRG
< prev
next >
Wrap
Text File
|
1988-12-04
|
3KB
|
144 lines
**********************************************************************
* Program......: CUSTMENU.PRG
* Author.......: This is an APPLICATION OBJECT.
* Date.........: 12-04-88
* Notice.......: Type information here or greetings to your users.
* dBASE Ver....: See Application menu to use as sign-on banner.
* Generated by.: APGEN version 1.0
* Description..: Customer Menu Class Example
* Description..: Menu actions
**********************************************************************
PROCEDURE CUSTMENU
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="01"
DO SET01
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE MENU CUSTMENU
@ 1,0 CLEAR TO 3,79
*-- After menu
RETURN
*-- EOP CUSTMENU
PROCEDURE SET01
ON KEY LABEL F1 DO 1HELP1
DO DBF01 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/B
SET COLOR OF TITLES TO W+/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
SET BORDER TO
@ 1,0 TO 3,79 DOUBLE COLOR B/W
@ 2,1 CLEAR TO 2,78
@ 2,1 FILL TO 2,78 COLOR W+/B
@ 2,10 SAY "ADD" COLOR W+/B
@ 2,22 SAY "CHANGE" COLOR W+/B
@ 2,38 SAY "REPORT" COLOR W+/B
@ 2,69 SAY "EXIT" COLOR W+/B
@ 22,00
ENDIF
RETURN
PROCEDURE DBF01
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CUSTOMER
SET ORDER TO CUSTNAME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CUSTOMER.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT01
*-- Begin CUSTMENU: BAR Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE "PAD_1" = PAD()
ACTIVATE WINDOW Browscr
SET SCOREBOARD ON
*-- Desc: attach format file CUSTOMER
SET FORMAT TO CUSTOMER
APPEND
*-- close format file so as not to affect READ's
SET FORMAT TO
SET SCOREBOARD OFF
DEACTIVATE WINDOW Browscr
CASE "PAD_2" = PAD()
ACTIVATE WINDOW Browscr
SET SCOREBOARD ON
*-- Desc: attach format file CUSTOMER
SET FORMAT TO CUSTOMER
EDIT NOAPPEND
*-- close format file so as not to affect READ's
SET FORMAT TO
SET SCOREBOARD OFF
DEACTIVATE WINDOW Browscr
CASE "PAD_3" = PAD()
ACTIVATE WINDOW Savescr
*-- Desc: Report
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
REPORT FORM CUSTOMER PLAIN NOEJECT
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
CASE "PAD_4" = PAD()
*-- Return to caller
gc_quit='Q'
DEACTIVATE MENU && CUSTMENU
RETURN
OTHERWISE
@ 24,00
@ 24,21 SAY "This item has no action. Press a key."
x=INKEY(0)
@ 24,00
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE MENU && CUSTMENU
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN